home *** CD-ROM | disk | FTP | other *** search
/ BCI NET 2 / BCI NET 2.iso / archives / applications / databases / video_13.lha / Video / Video.p < prev    next >
Encoding:
Text File  |  1994-12-19  |  20.6 KB  |  646 lines
  1. program Video;
  2.  
  3. {$I "include:Exec/Ports.i"}
  4. {$I "include:Intuition/Intuition.i"}
  5. {$I "include:Utils/CRT.i"}
  6. {$I "include:Utils/StringLib.i"}
  7. {$I "include:Utils/TimerUtils.i"}
  8. {$I "include:Utils/GDateTools.i"}
  9. {$I-}
  10.  
  11. const
  12.     line="________________________________________________________________________________";
  13.     space="                                                                                ";
  14.     fkey:array[1..10]of string=(    { Immer 41 Zeichen incl. 0-Byte! }
  15.     "Action\0                                  ",
  16.     "Krimi\0                                   ",
  17.     "Komödie\0                                 ",
  18.     "Fantasy\0                                 ",
  19.     "Horror\0                                  ",
  20.     "Science Fiction\0                         ",
  21.     "Zeichentrick\0                            ",
  22.     "Abenteuerfilm\0                           ",
  23.     "Psycho\0                                  ",
  24.     "Thriller\0                                ");
  25.     StdInName:String=NIL;
  26.     StdOutName:String=NIL;    { Öffnet dann kein CLI-Fenster }
  27.  
  28. type
  29.     t_eintrag=record
  30.         titel,komment,nummer:string;
  31.         laenge:short;
  32.         next,prev:^t_eintrag
  33.     end;
  34.     t_video=^t_eintrag;
  35.     t_erlaubt=(ALLES,ZAHLEN,BUCHST);
  36.  
  37. var w:WindowPtr;
  38.     ConBuf:Address;
  39.     last,cass:t_video;
  40.     anzahl:short;
  41.     saved:boolean;
  42.     timer:TimeRequestPtr;
  43.     suchnum,suchstr:string;
  44.  
  45. function OpenTheWindow:Boolean;
  46. var nw:NewWindowPtr;
  47. begin
  48.   new(nw);
  49.   with nw^ do begin
  50.     LeftEdge:=0; TopEdge:=0; Width:=640; Height:=256;
  51.     DetailPen:=-1; BlockPen:=-1; IDCMPFlags:=0;
  52.     Flags:=WINDOWSIZING+WINDOWDRAG+WINDOWDEPTH+SMART_REFRESH+ACTIVATE;
  53.     FirstGadget:=nil; CheckMark:=nil;
  54.     Title:=" Video-Datei-Verwaltung  V1.3  ·  © Copyright 92-95 by Henning Peters ";
  55.     Screen:=Nil; BitMap:=nil;
  56.     MinWidth:=640; MaxWidth:=-1; MinHeight:=200; MaxHeight:=-1;
  57.     WType:=WBENCHSCREEN_f;
  58.   end;
  59.   w:=OpenWindow(nw); dispose(nw);
  60.   OpenTheWindow:=w<>nil;
  61. end;
  62.  
  63. procedure WriteChar(c:char);
  64. var s:string;
  65. begin
  66.   s:=AllocString(2); s[1]:='\0'; s[0]:=c; WriteString(ConBuf,s)
  67. end;
  68.  
  69. function str_int(str:string):integer;
  70. var i,j:integer;
  71. begin
  72.   i:=0;
  73.   for j:=0 to pred(strlen(str)) do i:=i*10+ord(str[j])-48;
  74.   str_int:=i
  75. end;
  76.  
  77. function int_str(i:integer):string;    { i=0..9999 }
  78. var str:string;
  79. begin str:=AllocString(5); strcpy(str,"\0\0\0\0\0");
  80.   if i<10 then str[0]:=chr(i+48)
  81.   else if i<100 then begin
  82.     str[0]:=chr(i div 10+48); str[1]:=chr(i mod 10+48)
  83.   end else if i<999 then begin
  84.          str[0]:=chr(i div 100+48); str[1]:=chr((i mod 100)div 10+48);
  85.          str[2]:=chr(i mod 10+48)
  86.        end else begin
  87.          str[0]:=chr(i div 1000+48); str[1]:=chr((i mod 1000)div 100+48);
  88.          str[2]:=chr((i mod 100)div 10+48); str[3]:=chr(i mod 10+48)
  89.        end;
  90.   int_str:=str
  91. end;
  92.  
  93. function lowercase(str:string):string;
  94. var s:string;
  95.   i,j:integer;
  96. begin
  97.   s:=strdup(str); j:=pred(strlen(s));
  98.   for i:=0 to j do s[i]:=tolower(s[i]);
  99.   lowercase:=s
  100. end;
  101.  
  102. function strpart(s:string; p,l:short):string;
  103. var str:string;
  104.   i:integer;
  105.   e:byte;
  106. begin
  107.   str:=AllocString(succ(l)); e:=pred(p+l);
  108.   for i:=p to e do str[i-p]:=s[i];
  109.   str[succ(l)]:='\0'; strpart:=str
  110. end;
  111.  
  112. function ja_nein:boolean;
  113. var c:char;
  114. begin
  115.   repeat c:=tolower(readkey(ConBuf)) until (c='j') or (c='n') or (c='\e');
  116.   if c='\e' then c:='n'; WriteChar(c); ja_nein:=(c='j')
  117. end;
  118.  
  119. function stringlen(str:string):byte;
  120. var i:byte;
  121. begin
  122.   i:=pred(strlen(str));
  123.   while (str[i]='_') and (i>-1) do dec(i);
  124.   stringlen:=succ(i)
  125. end;
  126.  
  127. function GetString(vorgabe:string; len:byte; erlaubt:t_erlaubt):string;
  128. var l,x,y,b,pos,slen:byte;
  129.   str,s1,s2:string;
  130.   c:char;
  131.   i:integer;
  132.   ok:boolean;
  133. begin
  134.   x:=succ(wherex(ConBuf)); y:=succ(wherey(ConBuf));
  135.     { Scheint so, als wenn where_=[0..max-1] und gotoxy=[1..max] }
  136.   str:=AllocString(succ(len)); slen:=strlen(vorgabe); pos:=0;
  137.   strcpy(str,vorgabe); if slen<len then strncat(str,line,len-slen); s1:=strdup(str);
  138.   GotoXY(ConBuf,x,y); WriteString(ConBuf,str); GotoXY(ConBuf,x,y);
  139.   repeat
  140.     c:=readkey(ConBuf); b:=ord(c);
  141.     if (erlaubt=ALLES) or (erlaubt=BUCHST) then ok:=((b>31) and (b<127)) or (b>160)
  142.     else ok:=(b>47) and (b<58); { Nur '0'..'9' }
  143.     if ok then begin
  144.       if (pos=slen) and (slen<len) then begin
  145.     str[pos]:=c; GotoXY(ConBuf,x+pos,y); WriteChar(c)
  146.       end else
  147.     if (slen<len) then begin
  148.       for i:=pred(slen) downto pos do str[succ(i)]:=str[i];
  149.       str[pos]:=c;
  150.       GotoXY(ConBuf,x,y); WriteString(ConBuf,str); GotoXY(ConBuf,x+pos,y)
  151.     end else if pos<len then str[pos]:=c;
  152.       if (slen<len) then begin inc(slen); inc(pos) end
  153.     end else begin
  154.       case b of
  155.        155:begin
  156.       c:=readkey(ConBuf);
  157.       case ord(c) of
  158.         65:pos:=0;
  159.         66:pos:=slen;
  160.         67:if pos<slen then inc(pos);
  161.         68:if pos>0 then dec(pos);
  162.         63:if erlaubt=ALLES then begin    { Help }
  163.           WriteString(ConBuf,"\n\n");
  164.           for i:=1 to 10 do begin
  165.         WriteChar('\t'); WriteString(ConBuf,fkey[i]);
  166.         WriteChar('\n') end;
  167.           y:=wherey(ConBuf)-11;
  168.           GotoXY(ConBuf,0,succ(y));
  169. WriteString(ConBuf,"\n\e[4m\e[41m\e[30m F1 \n F2 \n F3 \n F4 \n F5 \n F6 \n F7 \n F8 \n F9 \n F10 \e[0m");
  170.           GotoXY(ConBuf,x,y)
  171.         end;
  172.         48..57:if (erlaubt=ALLES) and
  173.         (strlen(fkey[ord(c)-47])+pos<=len) then begin { F-Tasten }
  174.           b:=ord(c)-47; s2:=fkey[b]; l:=strlen(s2); 
  175.           if slen>0 then for i:=slen downto pos do str[i+l]:=str[i];
  176.           for i:=0 to pred(l) do str[pos+i]:=s2[i];
  177.           inc(slen,l); inc(pos,l); ok:=true
  178.         end
  179.       end;
  180.       while keypressed(ConBuf) do c:=readkey(ConBuf);
  181.     end;    { Fuer '~' am Ende, Shift-F-Tasten etc. }
  182.        27:begin s2:=str; str:=s1; s1:=s2; ok:=true; slen:=stringlen(str); pos:=slen end;
  183.        160:begin s2:=str; str:=s1; s1:=s2; ok:=true;
  184.          strncpy(str,line,len); slen:=0; pos:=0 end;
  185.        8:if pos>0 then begin
  186.       dec(slen); for i:=pos to slen do str[pred(i)]:=str[i];
  187.       str[slen]:='_'; dec(pos); ok:=true
  188.     end;
  189.        127:if pos<slen then begin
  190.       if pos<pred(slen) then
  191.         for i:=pos to pred(slen) do str[i]:=str[succ(i)];
  192.       dec(slen); str[slen]:='_'; ok:=true;
  193.       if (pos=slen) and (pos>0) then dec(pos)
  194.     end
  195.       end;
  196.       if ok then begin GotoXY(ConBuf,x,y); WriteString(ConBuf,str) end
  197.     end;
  198.     GotoXY(ConBuf,x+pos,y)
  199.   until b=13;
  200.   if slen=0 then begin if erlaubt=ZAHLEN then str[0]:='0' else str[0]:=' '; slen:=1 end;
  201.   strncpy(str,str,slen); strcpy(s1,str); if slen<len then strncat(s1,space,len-slen);
  202.   GotoXY(ConBuf,x,y); WriteString(ConBuf,s1); GetString:=str
  203. end;
  204.  
  205. procedure funktionstasten;
  206. var i:integer;
  207.   s:string;
  208.   c1,c2:char;
  209. begin
  210.   WriteString(ConBuf,"\f    \e[42m Funktionstastenbelegung ändern \e[0m\n\n");
  211. WriteString(ConBuf,"\e[4m\e[41m\e[30m F1 \n F2 \n F3 \n F4 \n F5 \n F6 \n F7 \n F8 \n F9 \n F10 \e[0m");
  212.   for i:=1 to 10 do begin GotoXY(ConBuf,8,2+i); WriteString(ConBuf,fkey[i]) end;
  213.   WriteString(ConBuf,"\n\n\e[41m\e[30m Esc \e[0m    Abbruch\n\n    Welche Taste ändern? ");
  214.   repeat
  215.     repeat
  216.       repeat c1:=readkey(ConBuf) until (c1='\c') or (c1='\e');
  217.       if c1='\e' then return;
  218.       c2:=readkey(ConBuf);
  219.     until (c2>'/') and (c2<':');
  220.     c1:=readkey(ConBuf); if c1<'~' then begin c2:=c1; c1:=readkey(ConBuf) end;
  221.     i:=ord(c2)-47; GotoXY(ConBuf,8,2+i); CursOn(ConBuf);
  222.     s:=GetString(fkey[i],40,ALLES); CursOff(ConBuf);
  223.     strcpy(fkey[i],s)
  224.   until false
  225. end;
  226.  
  227. procedure einsort(neu:t_video);
  228. var c:t_video;
  229. begin
  230.   if cass=nil then begin
  231.     neu^.next:=neu; neu^.prev:=neu; cass:=neu; last:=neu
  232.   end else begin
  233.     c:=cass;
  234.     while (stricmp(neu^.titel,c^.titel)>0) and (c<>last) do c:=c^.next;
  235.     if (c=last) and (stricmp(neu^.titel,c^.titel)>0) then c:=cass;
  236.     neu^.next:=c; neu^.prev:=c^.prev; c^.prev^.next:=neu; c^.prev:=neu;
  237.     if (c=cass) then
  238.       if (stricmp(neu^.titel,cass^.titel)<0) then cass:=neu
  239.       else last:=neu
  240.   end; inc(anzahl);
  241. end;
  242.  
  243. procedure ausklinken(var v:t_video);
  244. var d:t_video;
  245. begin
  246.   v^.prev^.next:=v^.next; v^.next^.prev:=v^.prev; d:=v; v:=v^.next;
  247.   dispose(d); saved:=false; dec(anzahl);
  248. end;
  249.  
  250. procedure eingabe(a,b,c,d:string; var t,k,l,n:string);
  251. begin
  252.   WriteChar('\n'); InsLine(ConBuf); InsLine(ConBuf);
  253.   WriteString(ConBuf,"\nTitel    : "); t:=strdup(GetString(a,60,ALLES));
  254.   WriteChar('\n'); InsLine(ConBuf);
  255.   WriteString(ConBuf,"Kommentar: "); k:=strdup(GetString(b,60,ALLES));
  256.   WriteChar('\n'); InsLine(ConBuf);
  257.   WriteString(ConBuf,"Länge    :   min");
  258.   GotoXY(ConBuf,wherex(ConBuf)-6,succ(wherey(ConBuf)));
  259.   l:=strdup(GetString(c,3,ZAHLEN)); WriteChar('\n'); InsLine(ConBuf);
  260.   WriteString(ConBuf,"Nummer   : "); n:=strdup(GetString(d,3,BUCHST));
  261.   saved:=false
  262. end;
  263.  
  264. procedure eingeben;
  265. var neu:t_video;
  266.   c:char;
  267.   t,k,l,n:string;
  268. begin
  269.   WriteString(ConBuf,"\f    \e[42m Neue Titel eingeben \e[0m");
  270.   repeat
  271.     new(neu); eingabe("","","","",t,k,l,n);
  272.     neu^.titel:=t; neu^.komment:=k;
  273.     neu^.laenge:=str_int(l); neu^.nummer:=n;
  274.     einsort(neu); WriteChar('\n'); InsLine(ConBuf); InsLine(ConBuf);
  275.     WriteString(ConBuf,"\n    Noch ein Titel (j/n)? ");
  276.   until not ja_nein
  277. end;
  278.  
  279. procedure ausgabe(v:t_video);
  280. begin
  281.   WriteString(ConBuf,"\n\n\e[2mTitel    : \e[0m");
  282.   WriteString(ConBuf,v^.titel);
  283.   WriteString(ConBuf,"\n\e[2mKommentar: \e[0m");
  284.   WriteString(ConBuf,v^.komment);
  285.   WriteString(ConBuf,"\n\e[2mLänge    : \e[0m");
  286.   WriteString(ConBuf,int_str(v^.laenge));
  287.   WriteString(ConBuf," min      \e[2mNummer: \e[0m");
  288.   WriteString(ConBuf,v^.nummer)
  289. end;
  290.  
  291. procedure ansehen;
  292. var v:t_video;
  293.   c:byte;
  294. begin
  295.   WriteString(ConBuf,"\e[0 p\f    \e[42m Alle Titel ansehen \e[0m");
  296.   v:=cass;
  297.   repeat
  298.     ausgabe(v);
  299.     WriteString(ConBuf,
  300. "\n\n    \e[42m    \e[0m=Weiter, \e[42m Esc \e[0m=Abbruch, \e[42m ^ \e[0m=Zurück");
  301.     repeat
  302.       c:=ord(readkey(ConBuf));
  303.       if c=155 then c:=ord(readkey(ConBuf))
  304.     until (c=65) or (c=32) or (c=27);
  305.     case c of
  306.       65:v:=v^.prev;
  307.       32:v:=v^.next
  308.     end
  309.   until c=27
  310. end;
  311.  
  312. function such_text(wie:char; v:t_video):t_video;
  313. var l:byte;
  314.   q,p:integer;
  315.   s:string;
  316. begin
  317.   l:=strlen(suchstr); s:=lowercase(suchstr); FreeString(suchstr); suchstr:=s;
  318.   repeat
  319.     if wie='k' then s:=lowercase(v^.komment) else s:=lowercase(v^.titel);
  320.     p:=strlen(s)-l;
  321.     if p>0 then for q:=0 to p do
  322.       if s[q]=suchstr[0] then
  323.     if strieq(strpart(s,q,l),suchstr) then such_text:=v;
  324.     v:=v^.next;
  325.   until v=cass;
  326.   such_text:=nil
  327. end;
  328.  
  329. function such_nummer(v:t_video):t_video;
  330. begin
  331.   repeat
  332.     if strcmp(suchnum,v^.nummer)=0 then such_nummer:=v;
  333.     v:=v^.next
  334.   until v=cass;
  335.   such_nummer:=nil
  336. end;
  337.   
  338. function such_video(var c:char):t_video;
  339. begin
  340.   WriteString(ConBuf,
  341. "\n\nSuchen nach \e[42m T \e[0mitel, \e[42m K \e[0mommentar oder \e[42m N \e[0mummer? ");
  342.   repeat c:=tolower(readkey(ConBuf)) until (c='t') or (c='k') or (c='n');
  343.   WriteChar(toupper(c));
  344.   if (c='k') or (c='t') then begin
  345.     WriteString(ConBuf,"\nSuchstring: "); suchstr:=strdup(GetString("",60,ALLES));
  346.     such_video:=such_text(c,cass)
  347.   end else begin
  348.     WriteString(ConBuf,"\nSuchnummer: "); suchnum:=strdup(GetString("",3,BUCHST));
  349.     such_video:=such_nummer(cass)
  350.   end
  351. end;
  352.  
  353. procedure aendern;
  354. var v,d:t_video;
  355.   c:char;
  356.   str,l,n:string;
  357.   num:byte;
  358.   jn:boolean;
  359. begin
  360.   WriteString(ConBuf,"\f    \e[42m Titel ändern \e[0m");
  361.   repeat
  362.     v:=such_video(c); jn:=true;
  363.     if v<>nil then repeat
  364.       ausgabe(v);
  365.       WriteString(ConBuf,"\n\n    Diesen Titel \e[33mändern\e[0m (j/n)? ");
  366.       if ja_nein then begin
  367.     l:=int_str(v^.laenge); n:=v^.nummer;
  368.     eingabe(v^.titel,v^.komment,l,n,v^.titel,v^.komment,l,n);
  369.     new(d); d^.titel:=v^.titel; d^.komment:=v^.komment;
  370.     d^.laenge:=str_int(l); d^.nummer:=n;
  371.     ausklinken(v); einsort(d)    { Neu einsortieren }
  372.       end;
  373.       WriteString(ConBuf,"\n\n    Nächsten Titel suchen (j/n)? ");
  374.       jn:=ja_nein;
  375.       if jn then if (c='t') or (c='k') then v:=such_text(c,v^.next)
  376.         else v:=such_nummer(v^.next)
  377.     until (not jn) or (v=nil);
  378.     if v=nil then WriteString(ConBuf,"\n\n    Keinen passenden Titel gefunden!");
  379.     WriteString(ConBuf,"\n\n    Noch einen Titel suchen (j/n)? ");
  380.     jn:=ja_nein
  381.   until not jn
  382. end;
  383.  
  384. procedure suchen;
  385. var v:t_video;
  386.   c:char;
  387.   str,l,n:string;
  388.   num:byte;
  389.   jn:boolean;
  390. begin
  391.   WriteString(ConBuf,"\f    \e[42m Titel suchen \e[0m");
  392.   repeat
  393.     v:=such_video(c); jn:=true;
  394.     if v<>nil then repeat
  395.       ausgabe(v);
  396.       WriteString(ConBuf,"\n\n    Nächsten Titel suchen (j/n)? ");
  397.       jn:=ja_nein;
  398.       if jn then if (c='t') or (c='k') then v:=such_text(c,v^.next)
  399.         else v:=such_nummer(v^.next)
  400.      until (not jn) or (v=nil);
  401.     if v=nil then WriteString(ConBuf,"\n\n    Keinen passenden Titel gefunden!");
  402.     WriteString(ConBuf,"\n\n    Noch einen Titel suchen (j/n)? ");
  403.     jn:=ja_nein
  404.   until not jn
  405. end;
  406.  
  407. procedure loeschen;
  408. var v:t_video;
  409.   c:char;
  410.   str:string;
  411.   num:byte;
  412.   jn:boolean;
  413. begin
  414.   WriteString(ConBuf,"\f    \e[42m Titel löschen \e[0m");
  415.   repeat
  416.     v:=such_video(c);
  417.     if v<>nil then repeat
  418.       ausgabe(v);
  419.       WriteString(ConBuf,"\n\n    Diesen Titel \e[33mlöschen\e[0m (j/n)? ");
  420.       if ja_nein then begin
  421.         ausklinken(v); WriteString(ConBuf,"\n\n    Titel gelöscht.\n")
  422.       end;
  423.       WriteString(ConBuf,"\n    Nächsten Titel suchen (j/n)? ");
  424.       jn:=ja_nein;
  425.       if jn then if (c='t') or (c='k') then v:=such_text(c,v^.next)
  426.         else v:=such_nummer(v^.next)
  427.     until (not jn) or (v=nil);
  428.     if v=nil then WriteString(ConBuf,"\n\n    Keinen passenden Titel gefunden!");
  429.     WriteString(ConBuf,"\n\n    Noch einen Titel suchen (j/n)? ");
  430.     jn:=ja_nein
  431.   until not jn
  432. end;
  433.  
  434. procedure IO_error(txt:string; err:byte);
  435. var s:string;
  436. begin
  437.   case err of
  438.      50:s:="Kein Speicher für IO-Puffer";
  439.     103:s:="Nicht genug Speicherplatz";
  440.     202:s:="Datei in Gebrauch";
  441.     203:s:="Datei existiert bereits";
  442.     204:s:="Verzeichnis nicht gefunden";
  443.     205:s:="Datei nicht gefunden";
  444.     213:s:="Disk ist nicht validiert";
  445.     214:s:="Disk ist schreibgeschützt";
  446.     218:s:="Gerät nicht ansprechbar";
  447.     221:s:="Disk ist voll";
  448.     223:s:="Datei ist schreibgeschützt";
  449.     224:s:="Datei ist lesegeschützt";
  450.     225:s:="Keine DOS-Disk";
  451.     226:s:="Keine Disk im Laufwerk";
  452.     else begin
  453.       s:=AllocString(20); strcpy(s,"Fehler Nummer "); strcat(s,int_str(err))
  454.     end
  455.   end;
  456.   WriteString(ConBuf,"\n\n\a    \e[33mFehler\e[0m beim ");
  457.   WriteString(ConBuf,txt); WriteString(ConBuf,": "); WriteString(ConBuf,s);
  458.   WriteString(ConBuf,".\n\n    Weiter mit einer Taste ");
  459.   while not keypressed(ConBuf) do
  460. end;
  461.  
  462. procedure speichern;
  463. var v:t_video;
  464.   f:text;
  465.   s:string;
  466.   err:byte;
  467.   over:boolean;
  468.   i:integer;
  469. begin
  470.   WriteString(ConBuf,
  471.     "\f    \e[42m Titel speichern \e[0m\n\nFilename (voller Pfad):\n");
  472.   s:=strdup(GetString("s:Video-Datei",75,ALLES));
  473.   reset(f,s); err:=ioresult; close(f);
  474.   if err=0 then begin
  475.     WriteString(ConBuf,"\n\n\a    Datei existiert bereits! \e[33mÜberschreiben\e[0m (j/n)? ");
  476.     over:=ja_nein; if not over then return
  477.   end;
  478.   WriteString(ConBuf,"\n\nSchreibe Daten");
  479.   rewrite(f,s); err:=ioresult;
  480.   if not ((err=203) and over) then if err>0 then begin
  481.     if over then io_error("Überschreiben der alten Datei",err)
  482.     else io_error("Öffnen der Datei: ",err); close(f); return
  483.   end;
  484.   v:=cass; i:=1; err:=0;
  485.   while (err=0) and (i<11) do begin writeln(f,fkey[i]); err:=ioresult; inc(i) end;
  486.   if err>0 then begin io_error("Schreiben",err); close(f); return end;
  487.   repeat
  488.     writeln(f,v^.titel,"\n",v^.komment,"\n",v^.laenge,":",v^.nummer);
  489.     err:=ioresult; WriteChar('.');
  490.     if err>0 then begin io_error("Schreiben",err); close(f); return end;
  491.     v:=v^.next
  492.   until v=cass;
  493.   close(f); err:=ioresult;
  494.   if err>0 then io_error("Schließen der Datei",err)
  495.   else begin
  496.     WriteString(ConBuf,"Ok."); saved:=true;
  497.     WriteString(ConBuf,"\n\n    Weiter mit einer Taste ");
  498.     while not keypressed(ConBuf) do
  499.   end
  500. end;
  501.  
  502. procedure laden;
  503. var v:t_video;
  504.   f:text;
  505.   t,k,n:string;
  506.   err:byte;
  507.   l:short;
  508.   i:integer;
  509.   c:char;
  510. begin
  511.   WriteString(ConBuf,"\f    \e[42m Titel laden \e[0m");
  512.   if not saved then begin
  513.     WriteString(ConBuf,"\n\nDaten sind nicht gepeichert! \e[33mÜberschreiben?\e[0m (j/n)? ");
  514.     if not ja_nein then return
  515.   end;
  516.   WriteString(ConBuf,"\n\nFilename (voller Pfad):\n");
  517.   t:=strdup(GetString("s:Video-Datei",75,ALLES));
  518.   reset(f,t); err:=ioresult;
  519.   if err>0 then begin io_error("Öffnen der Datei",err); close(f); return end;
  520.   if anzahl>0 then        { Alte Daten löschen }
  521.     if anzahl=1 then dispose(cass)
  522.     else begin
  523.       v:=cass;
  524.       repeat ausklinken(v^.prev) until v=v^.next;
  525.       dispose(v)
  526.     end;
  527.   WriteString(ConBuf,"\n\nLese Daten"); anzahl:=0; cass:=nil; i:=1; err:=0;
  528.   FreeString(t); t:=AllocString(61); k:=AllocString(61); n:=AllocString(4);
  529.   while (err=0) and (i<11) do begin
  530.     readln(f,t); err:=ioresult; if err=0 then strcpy(fkey[i],t); inc(i)
  531.   end;
  532.   if err>0 then begin io_error("Lesen",err); close(f); return end;
  533.   repeat
  534.     readln(f,t); err:=ioresult;
  535.     if err=0 then begin readln(f,k); err:=ioresult end;
  536.     if err=0 then begin readln(f,l,c,n); err:=ioresult end;
  537.     if err>0 then begin io_error("Lesen",err); close(f); return end;
  538.     new(v); v^.titel:=strdup(t); v^.komment:=strdup(k); v^.laenge:=l;
  539.     v^.nummer:=strdup(n); WriteChar('.'); einsort(v)
  540.   until eof(f);
  541.   close(f); WriteString(ConBuf,"Ok.\n\n    Weiter mit einer Taste ");
  542.   while not keypressed(ConBuf) do; saved:=true
  543. end;
  544.  
  545. procedure drucken;
  546. var drucker:text;
  547.     v:t_video;
  548.     c:byte;
  549. begin
  550.   WriteString(ConBuf,"\e[0 p\f    \e[42m Alle Titel drucken \e[0m\n\nAbbruch mit \e[42m Esc \e[0m.\n");
  551.   reset(drucker,"prt:"); c:=ioresult;
  552.   if c>0 then begin
  553.     io_error("Ansprechen des Druckers",c); close(drucker); return
  554.   end;
  555.   v:=cass; c:=0; WriteString(ConBuf,"\nDrucke Titel");
  556.   repeat
  557.     WriteLn(drucker,"\n\e[1mTitel    : \e[0m",v^.titel,"\n\e[1mKommentar: \e[0m",
  558.     v^.komment,"\n\e[1mLänge    : \e[0m",int_str(v^.laenge):4,
  559.     " min      \e[1mNummer: \e[0m",v^.nummer);
  560.     v:=v^.next; WriteChar('.');
  561.     if keypressed(ConBuf) then c:=ord(readkey(ConBuf));
  562.   until (v=cass) or (c=27);
  563.   close(drucker)
  564. end;
  565.  
  566. function my_menu:char;
  567. var c1,c2:char;
  568.   h,m,s:byte;
  569.   sec,t:integer;
  570.   time:DateDescription;
  571.   tv:timeval;
  572.   str:string;
  573. begin
  574.   str:=AllocString(42);
  575.   WriteString(ConBuf,"\e[0 p\f\n    \e[42m H a u p t m e n ü \e[0m\n\n");
  576.   WriteString(ConBuf,"    \e[4;30;41m F1  \e[0m Titel eingeben\n");
  577.   WriteString(ConBuf,"    \e[4;30;41m F2  \e[0m Titel ansehen\n");
  578.   WriteString(ConBuf,"    \e[4;30;41m F3  \e[0m Titel ändern\n");
  579.   WriteString(ConBuf,"    \e[4;30;41m F4  \e[0m Titel suchen\n");
  580.   WriteString(ConBuf,"    \e[4;30;41m F5  \e[0m Titel löschen\n");
  581.   WriteString(ConBuf,"    \e[4;30;41m F6  \e[0m Titel speichern\n");
  582.   WriteString(ConBuf,"    \e[4;30;41m F7  \e[0m Titel laden\n");
  583.   WriteString(ConBuf,"    \e[4;30;41m F8  \e[0m Titel drucken\n");
  584.   WriteString(ConBuf,"    \e[4;30;41m F9  \e[0m Funktionstastenbelegung ändern\n");
  585.   WriteString(ConBuf,"    \e[4;30;41m F10 \e[0m Programm beenden\n\n");
  586.   WriteString(ConBuf,int_str(anzahl));
  587.   WriteString(ConBuf," Titel im Speicher");
  588.   if not saved then WriteString(ConBuf,", Daten wurden verändert");
  589.   WriteString(ConBuf,".");
  590.   repeat sec:=0;
  591.    repeat
  592.     GetSysTime(timer,tv);
  593.     if sec<>tv.tv_secs then begin
  594.       sec:=tv.tv_secs; t:=sec mod 86400;
  595.       h:=t div 3600; m:=(t mod 3600)div 60; s:=t mod 60;
  596.       GetDescription(tv.tv_secs,time);    { TimeDesc() gibt Müll bei h/m/s }
  597.       strcpy(str," "); strcat(str,DayNames[time.dow]); strcat(str,", ");
  598.       strcat(str,int_str(time.day)); strcat(str,".");
  599.       strcat(str,int_str(time.month)); strcat(str,".");
  600.       strcat(str,int_str(time.year)); strcat(str,", ");
  601.       strcat(str,int_str(h)); strcat(str,":");
  602.       if m<10 then strcat(str,"0"); strcat(str,int_str(m)); strcat(str,":");
  603.       if s<10 then strcat(str,"0"); strcat(str,int_str(s));
  604.       GotoXY(ConBuf,MaxX(ConBuf)-strlen(str),1); WriteString(ConBuf,str)
  605.     end;
  606.     if keypressed(ConBuf) then c1:=readkey(ConBuf)
  607.    until c1='\c';
  608.    c2:=readkey(ConBuf)
  609.   until (c2>'/') and (c2<':');    { F-Tasten='<CSI>[0..9]~' }
  610.   c1:=readkey(ConBuf); if c1<'~' then begin c2:=c1; c1:=readkey(ConBuf) end;
  611.   CursOn(ConBuf);        { Shift-Fxx='<CSI>1[0..9]~' }
  612.   case c2 of
  613.     '0':eingeben;
  614.     '1':if anzahl>0 then ansehen;
  615.     '2':if anzahl>0 then aendern;
  616.     '3':if anzahl>0 then suchen;
  617.     '4':if anzahl>0 then loeschen;
  618.     '5':if anzahl>0 then speichern;
  619.     '6':laden;
  620.     '7':if anzahl>0 then drucken;
  621.     '8':funktionstasten;
  622.     '9':begin
  623.        GotoXY(ConBuf,15,17);
  624.        if not saved then WriteString(ConBuf,"\e[33mDatei wurde verändert! \e[0m");
  625.        WriteString(ConBuf,"\e[43m Programm beenden (j/n)?\e[0m");
  626.        if ja_nein then c2:='\0';
  627.       end
  628.   end;
  629.   my_menu:=c2
  630. end;
  631.  
  632. begin    { Main }
  633.   if OpenTheWindow then begin
  634.     ConBuf:=AttachConsole(w);
  635.     if ConBuf<>Nil then begin
  636.       timer:=CreateTimer;
  637.       if timer<>nil then begin
  638.     cass:=nil; anzahl:=0; saved:=true;
  639.     while my_menu>'\0' do;
  640.     DetachConsole(ConBuf); DeleteTimer(timer)
  641.       end else writeln("\aKann \e[33mtimer.device\e[0m nicht öffnen!")
  642.     end else writeln("\aKann \e[33mconsole.device\e[0m nicht öffnen!");
  643.     CloseWindow(w)
  644.   end else writeln("\aKann \e[33mFenster\e[0m nicht öffnen!")
  645. end.
  646.